home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Best of MacTutor - S…e Code for Volumes 1 to 5
/
The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin
/
Source Code
/
#49 (Oct 89)
/
SC #49.sit
/
Driver Code
/
test_drvr.a
< prev
next >
Wrap
Text File
|
1988-01-11
|
13KB
|
576 lines
TITLE 'Test of pump driver'
Case ON
BLANKS ON
Machine MC68020
PRINT OFF
INCLUDE 'Traps.a'
INCLUDE 'ToolEqu.a'
INCLUDE 'QuickEqu.a'
INCLUDE 'SysEqu.a'
INCLUDE 'SysErr.a'
INCLUDE 'TimeEqu.a'
INCLUDE 'Quickdraw.inc'
INCLUDE 'PumpErrs.inc'
LOAD 'ProgStrucMacs.d'
LOAD 'FlowCtlMacs.d'
PRINT ON
DgInfo Record
PumpAction DS.W 1
PumpRequest DS.W 1
PumpInfo DS.W 1
DCEntry DS.L 1
PumpDriverRef DS.W 1
DriverQueue DS.L 1
EndR
ItemStuff Record
itemType DS.W 1
itemHdl DS.L 1
itemRect DS.W Rect
itemHit DS.W 1
myEvent DS.L EventRecord ; Current event info
DialogPtr DS.L 1
Done DS.W 1
EndR
theDialog EQU A3 ;Dialog pointer
TestDLOG EQU 128 ;Resource ID for the dialog
QuitButton equ 2
ActionButton equ 1
S_Button equ 3
R_Button equ 4
V_Button equ 5
I_Button equ 6
Num_Button equ 7
Ask_Button equ 8
Set_Button equ 9
In_Field equ 10
Out_Field equ 11
ParamBlockSize equ 108
ActionOffset equ csParam
RequestOffset equ csParam+2
InfoOffset equ csParam+4
Ask equ 0
Set equ 1
S_request equ 0
R_request equ 1
V_request equ 2
I_request equ 3
Num_request equ 4
StatusAbnormal equ 200
RateReply equ 201
VolumeReply equ 202
InfusedReply equ 203
InvalidRequest equ 204
RdTmOut equ 205
WrTmOut equ 206
TooMany equ 207
UnDecode equ 208
UnkAction equ 209
UnkRequest equ 210
Misread equ 211
StatusSet equ 212
RateSet equ 213
VolumeSet equ 214
InfusedSet equ 215
PumpInitialized equ 216
BadProblem equ 217
StatusNormal equ 218
Exiting equ 219
Procedure SetRequestButton
Begin Save=D3-D4,with=(ItemStuff);
MOVE.W D0,D4
For# D3 = #S_Button To #Num_Button Do.S
Call _GetDItem (theDialog:L,D3:W,itemType:A,itemHdl:A,itemRect:A)
If# D3 EQ.W D4 Then.S
Call _SetCtlValue ( itemHdl:L , #1:W )
Else#.S
Call _SetCtlValue ( itemHdl:L , #0:W )
EndIf#
EndF#
MOVE.W D4,D0
Return
ENDP
Procedure SetActionButton
Begin Save=D3,with=(ItemStuff);
MOVE.W D0,D3
If# D3 EQ.W #Ask_Button Then.S
Call _GetDItem (theDialog:L,#Ask_Button:W,itemType:A,itemHdl:A,\
itemRect:A)
Call _SetCtlValue ( itemHdl:L , #1:W )
Call _GetDItem (theDialog:L,#Set_Button:W,itemType:A,itemHdl:A,\
itemRect:A)
Call _SetCtlValue ( itemHdl:L , #0:W )
ElseIf#.S D3 EQ.W #Set_Button Then.S
Call _GetDItem (theDialog:L,#Set_Button:W,itemType:A,itemHdl:A,\
itemRect:A)
Call _SetCtlValue ( itemHdl:L , #1:W )
Call _GetDItem (theDialog:L,#Ask_Button:W,itemType:A,itemHdl:A,\
itemRect:A)
Call _SetCtlValue ( itemHdl:L , #0:W )
EndIf#
MOVE.W D3,D0
Return
ENDP
Procedure HexDecode
Begin Save=D1-D3/A1,With=(DgInfo);
CLR.W D2
MOVE.B (A0)+,D3 ;Get the length byte
EXT.W D3
EXT.L D3
SUBQ.L #2,D3
ADDQ.L #1,A0 ;Toss the dollar sign
For# D3 DownTo #0 Do.S
MOVE.B (A0)+,D1
EXT.W D1
Switch# D1
Case#.S '0'..'9'
SUB.B #'0',D1
Leave#.S
Case#.S 'A'..'F'
SUB.B #'A'-10,D1
Leave#.S
Case#.S 'a'..'f'
SUB.B #'a'-10,D1
Leave#.S
Default#
call _SelIText ( theDialog:L , #In_Field:W , #0:W , #32767:W )
call _SysBeep ( #3:W )
MOVE.W #-1,D0
Return
EndS#
FoundIt LSL.W #4,D2
ADD.W D1,D2
EndF#
MOVE.W D2,PumpInfo
MOVE.W #0,D0
Return
Return
; STRING ASIS
;Table1Base DC.B '0123456789ABCDEF'
ENDP
MACRO
StringToNum
MOVE.W #1,-(SP)
_Pack7
ENDM
Procedure IntegerDecode
Begin Save=D1-D2,With=(DgInfo);
CLR.W D1
MOVE.B (A0)+,D2 ;Get the length byte
EXT.W D2
EXT.L D2
SUBQ.L #1,D2
For# D2 DownTo #0 Do.S
MOVE.B (A0)+,D0
SUB.B #'0',D0
If# MI OR D0 GT.B #9 Then.S
GoTo#.S Bad
EndIf#
EXT.W D0
MULU.W #10,D1
ADD.W D0,D1
EndF#
MOVE.W D1,PumpInfo
MOVE.W #0,D0
Return
Bad call _SelIText ( theDialog:L , #In_Field:W , #0:W , #32767:W )
call _SysBeep ( #3:W )
MOVE.W #-1,D0
Return
ENDP
Procedure ActionProc
Var TempString:B[256];
Begin Save=D0/A0-A1,With=(DgInfo,ItemStuff);
If# PumpAction EQ.W #Set Then.S
Call _GetDItem (theDialog:L,#In_Field:W,itemType:A,itemHdl:A,\
itemRect:A)
Call _GetIText ( itemHdl:L , TempString(FP):A )
LEA TempString(FP),A0
If# (A0) EQ.B #0 OR (A0) EQ.W #$0124 Then.S ;$0124 = Char(1)//'$'
MOVE.W #0,PumpInfo
Else#.S
If# 1(A0) EQ.B #'$' Then.S
Call HexDecode
Else#.S
Call IntegerDecode
EndIf#
If# D0 NE.W #0 Then.S
Return
EndIf#
EndIf#
Else#.S
MOVE.W #0,PumpInfo
EndIf#
*
* Set up the parameter block for the control call
*
MOVE.L #ParamBlockSize,D0
_NewPtr ,clear
MOVE.W PumpDriverRef,ioRefNum(A0)
MOVE.W PumpAction,ActionOffset(A0)
MOVE.W PumpRequest,RequestOffset(A0)
MOVE.W PumpInfo,InfoOffset(A0)
CLR.L ioCompletion(A0)
_Status ,async
If# D0 NE.W #0 Then.S
Call _GetDItem (theDialog:L,#Out_Field:W,itemType:A,itemHdl:A,\
itemRect:A)
Call _SetItext ( itemHdl:L , #'Driver unable to handle this call':A )
EndIf#
Return
ENDP
Procedure EventProc ( The_message:L )
Var TempString:B[256];
Begin Save=D0/A0-A2,With=(DgInfo,ItemStuff);
MACRO
NumToString
CLR.W -(SP)
_Pack7
ENDM
MOVE.L The_message(FP),A0
* The message is a parameter block pointer for the just completed pump driver call. First,
* check to see that the request completed without an error state.
MOVE.W ioResult(A0),D0
If# EQ Then
MOVE.L A0,A2
If# ActionOffset(A0) EQ.W #Set Then.S
MOVE.W RequestOffset(A0),D0
Switch# D0,JmpTbl=Y
Case#.S S_request
MOVE.W #StatusSet,D3
Leave#.S
Case#.S R_request
MOVE.W #RateSet,D3
Leave#.S
Case#.S V_request
MOVE.W #VolumeSet,D3
Leave#.S
Case#.S I_request
MOVE.W #InfusedSet,D3
Leave#.S
Case#.S Num_request
MOVE.W #PumpInitialized,D3
Leave#.S
Default#.S
MOVE.W #BadProblem,D3
EndS#
Call _GetString:L ( D3:W ),A0
_HLock
MOVE.L (A0),A1
Else#
MOVE.W RequestOffset(A0),D0
Switch# D0,JmpTbl=Y
Case#.S S_request
MOVE.W InfoOffset(A2),D1
AND.W #$000F,D1
If# D1 EQ.W #0 Then.S
MOVE.L #StatusNormal,D3
Call _GetString:L ( D3:W ),A0
_HLock
MOVE.L (A0),A1
Else#.S
MOVE.L #StatusAbnormal,D3
Call _GetString:L ( D3:W ),A0
_HLock
MOVE.L (A0),A1
CLR.W D4
For# D2 = #3 DownTo #0 Do.S
BTST D2,D1
If# EQ Then.S
LEA #'AOIB',A0
MOVE.B (A0,D2.W),21(A1,D4.W)
ADDQ.W #1,D4
EndIf#
EndF#
EndIf#
GoTo#.S StatusOut
Case#.S R_request
MOVE.L #RateReply,D3
Leave#.S
Case#.S V_request
MOVE.L #VolumeReply,D3
Leave#.S
Case#.S I_request
MOVE.L #InfusedReply,D3
Leave#.S
Case#.S Num_request
MOVE.L #InvalidRequest,D3
Call _GetString:L ( D3:W ),A0
_HLock
MOVE.L (A0),A1
GoTo#.S StatusOut
Default#.S
MOVE.L #BadProblem,D3
EndS#
Call _GetString:L ( D3:W ),A0
_HLock
MOVE.L (A0),A1
MOVE.L A1,-(SP)
MOVE.W InfoOffset(A2),D0
EXT.L D0
LEA TempString(FP),A0
NumToString
MOVE.B (A0)+,D0
MOVE.B (A1),D1
SUB.B D0,D1
EXT.W D1
EXT.W D0
EXT.L D0
LEA (A1,D1.W),A1
_BlockMove
MOVE.L (SP)+,A1
StatusOut:
EndIf#
Else#
MOVE.W ioResult(A0),D0
Switch# D0
Case#.S statusErr
MOVE.W #Exiting,D3
Leave#.S
Case#.S TimeOut+aRdCmd
MOVE.L #RdTmOut,D3
Leave#.S
Case#.S TimeOut+aWrCmd
MOVE.L #WrTmOut,D3
Leave#.S
Case#.S TooManyCharacters
MOVE.L #TooMany,D3
Leave#.S
Case#.S PumpUndecodableNumber
MOVE.L #UnDecode,D3
Leave#.S
Case#.S PumpUnknownAction
MOVE.L #UnkAction,D3
Leave#.S
Case#.S PumpUnknownRequest
MOVE.L #UnkRequest,D3
Leave#.S
Case#.S PumpMisread
MOVE.L #Misread,D3
Leave#.S
Default#.S
MOVE.W #BadProblem,D3
EndS#
Call _GetString:L ( D3:W ),A0
_HLock
MOVE.L (A0),A1
MOVE.L A1,-(SP)
MOVE.W ioResult(A2),D0
EXT.L D0
LEA TempString(FP),A0
NumToString
MOVE.B (A0)+,D0
MOVE.B (A1),D1
SUB.B D0,D1
EXT.W D1
EXT.W D0
EXT.L D0
LEA (A1,D1.W),A1
_BlockMove
MOVE.L (SP)+,A1
EndIf#
MOVE.L A2,A0
_DisposPtr
MOVE.L A1,A2
Call _GetDItem (theDialog:L,#Out_Field:W,itemType:A,itemHdl:A,\
itemRect:A)
Call _SetItext ( itemHdl:L , A2:L )
Return
ENDP
Procedure Test,MAIN=Y
Var theID:W , theType:B[4] , theName:B[256];
Begin With=(QuickDraw,DgInfo,ItemStuff)
*
* Initialization
*
call _InitGraf (thePort:A) ;Initialize QuickDraw
call _InitFonts ;Initialize Font Manager
MOVE.L #$0000FFFF,D0 ;Discard any previous events
_FlushEvents ;FlushEvents(EventEvent, 0);
_InitWindows ;Initialize Window Manager
_InitMenus ;Initialize Menu Manager
_TEInit ;Initialize TextEdit
call _InitDialogs (NIL) ;Initialize Dialog Manager
_InitCursor ;Make cursor an arrow
Call _GetNewDialog:L ( #TestDLOG , Nil , -1:A )
MOVE.L (A7),theDialog ;theDialog holds ptr to dialog info
_SetPort ;Set the current grafPort
MOVE.W #S_Button,D0
call SetRequestButton
MOVE.W #Ask_Button,D0
call SetActionButton
MOVE.W #0,PumpRequest
MOVE.W #0,PumpAction
MOVE.W #0,PumpInfo
CLR.W Done
* Initialize the pump driver
String Pascal
LEA #'.PumpDriver',A0
MOVE.B #0,1(A0)
Call _OpenDeskAcc:W ( A0:L ),PumpDriverRef
MOVE.W PumpDriverRef,D0
ADD.W #1,D0
NEG D0
MOVE.L UTableBase,A0
MOVE.L (A0,D0.W*4),A0
MOVE.L (A0),A0
LEA dCtlQHead(A0),A0
MOVE.L A0,DriverQueue
*
* Main loop
*
EventLoop Repeat#
If# Done EQ.W #-1 Then.s
MOVE.L DriverQueue,A0
CMP.L #0,(A0)
If# EQ Then.S
GoTo# Quit
EndIf#
EndIf#
Call _SystemTask ; Perform periodic actions defined for DAs
Call _GetNextEvent:B(#everyEvent, myEvent:A),CC; ToolBox Event Mgr
IF# NE THEN
If# myEvent.what EQ.W #app2Evt then.S
call _SysBeep ( #2:W )
call EventProc ( myEvent.message:L )
cycle#.S EventLoop
EndIf#
Call _IsDialogEvent:B ( myEvent:A ),CC
IF# EQ THEN.S
Switch#.S myEvent.what
Case#.S nullEvt
leave#.S
Default#
call _SysBeep ( #2:W )
EndS#
Else#
Call _DialogSelect:B ( myEvent:A , DialogPtr:A , itemHit:A ),CC
If# NE Then
MOVE.W itemHit,D2
Switch#.S D2
Case#.S QuitButton
For# D3 = #V_request DownTo #S_request Do.S
MOVE.L #ParamBlockSize,D0
_NewPtr ,clear
MOVE.W PumpDriverRef,ioRefNum(A0)
MOVE.W #Set,ActionOffset(A0)
MOVE.W D3,RequestOffset(A0)
CLR.L ioCompletion(A0)
CLR.W InfoOffset(A0)
_Status ,async
EndF#
MOVE.W #-1,Done
MOVE.L DriverQueue,A0
Leave#.S
Case#.S ActionButton
call ActionProc
Leave#.S
Case#.S S_Button..Num_Button
MOVE.W itemHit,D0
JSR SetRequestButton
SUB.W #S_Button,D0
MOVE.W D0,PumpRequest
Leave#.S
Case#.S Ask_Button,Set_Button
MOVE.W itemHit,D0
JSR SetActionButton
SUB.W #Ask_Button,D0
MOVE.W D0,PumpAction
Leave#.S
Default#
MOVE.W #2,-(SP)
_SysBeep
EndS#
EndIf#
EndIf#
Else#.S
Call _IsDialogEvent:B ( myEvent:A ),CC
Call _DialogSelect:B ( myEvent:A , DialogPtr:A , itemHit:A ),CC
EndIf#
Until# False
*
* User is now satisfied -- let's get out of here!
*
Quit:
Call _CloseDeskAcc ( PumpDriverRef:W )
MOVE.L A3,-(A7)
_CloseDialog
Return
ENDP
END ; of Test